SuperHack/SuperHack CD.bin/CODING/PASCAL/FPKPAS65.ZIP/SRCRTLDO.ZIP/SOURCE/RTL/DOS/FMOUSE.PP

Text File | 1996-07-23 | 6.0 KB | 300 lines

{*******************************************************}
{                                                       }
{              FMouse Unit version 1.0                  }
{            Made for FPK Pascal compiler               }
{                                                       }
{         Copyright (c) 1996 Felix Gartsman             }
{                                                       }
{*******************************************************}
{ The mail address of Felix Gartsmann is:
  [e-mail]
  Please send suggestions,bugs etc. to him.
}
Unit FMouse;

{version 1.0}

Interface

{Mouse support functions and procedures,with error checking if mouse
isn't present then the routine ends,if you want to remove error checking
erase the statement If Not Mouse Then Exit; from each routine}

{check if mouse is present and sets the mouse variable}
Function Check_Mouse:Boolean;
{shows mouse pointer,text+graphics screen support}
Procedure Show_Mouse;
{hides mouse pointer}
Procedure Hide_Mouse;
{reads mouse position in pixels,divide by 8 to get text position,and reads
buttons state(1-left button,2=right button,7=middle button)}
Procedure read_mouse (var x,y:Longint;var buttons:Longint);
{sets mouse pointer in text mode}
Procedure Mouse_Cur(X,Y:Longint);
{sets the mouse shape in text mode}
Procedure Mouse_Shape(BackColor,ForColor,Ascii:LongInt);
{sets the mouse ascii in text mode}
Procedure Mouse_Ascii(Ascii:LongInt);
{returns which button was pressed after last call to function}
Function mouse_press(var x,y:Longint;button:Longint):Longint;
{returns which button was realeased after last call to function}
Function mouse_release (var row,col:Longint;button : Longint):integer;
{set's mouse y range}
Procedure mouse_yrange (min,max:Longint);
{set's mouse y range}
Procedure mouse_xrange (min,max:Longint);
{set mouse speed}
Procedure Micky(Horizontal ,Vertical:Longint);
{return if right button pressed}
Function IsRPres:Boolean;
{return if left button pressed}
Function IsLPres:Boolean;
{set rectangle on screen that mouse will disappear if will point on it}
Procedure Unseen_Mouse(x1,y1,x2,y2:Longint);
{set window for mouse}
Procedure MWindow(x1,y1,x2,y2:Longint);

Var
Mouse:Boolean;

Implementation

Function Check_Mouse:Boolean;
begin
asm
movb $0,U_FMOUSE_MOUSE
movw $0,%AX
pushl %ebp
int     $0x33
popl %ebp
cmpw $0xffff,%ax
jz true
jmp sof
true:
movw $1,U_FMOUSE_MOUSE
sof:
end;
end;

procedure show_mouse;
begin
If (Not Mouse) Then Exit;
     asm
        movw $1,%ax
        pushl %ebp
        int   $0x33
        popl %ebp
     end;
end;

procedure hide_mouse;
begin
If (Not Mouse) Then Exit;
     asm
        movw $2,%ax
        pushl %ebp
        int   $0x33

        popl %ebp
     end;
end;

procedure read_mouse (var x,y:Longint;var buttons:Longint);
begin
If Not Mouse Then Exit;
     asm
        movw $3,%ax
        pushl %ebp
        int   $0x33
        popl %ebp
        movl 8(%ebp),%eax
        movw %cx,(%eax)
        movl 12(%ebp),%eax
        movw %dx,(%eax)
        movl 16(%ebp),%eax
        movw %bx,(%eax)
end;
end;

function mouse_press(var x,y:Longint;button:Longint):Longint;
begin
If Not Mouse Then Exit;
     asm
        movw $5,%ax
        movw 16(%ebp),%bx
        pushl %ebp
        int   $0x33
        popl %ebp
        movl 8(%ebp),%ebx
        movw %cx,(%ebx)
        movl 12(%ebp),%ebx
        movw %dx,(%ebx)
     end;
end;

function mouse_release (var row,col:Longint;button : Longint):integer;
begin
If Not Mouse Then Exit;
     asm
        movw $6,%ax
        movw 16(%ebp),%bx
        pushl %ebp
        int   $0x33
        popl %ebp
        movl 8(%ebp),%ebx
        movw %cx,(%ebx)
        movl 12(%ebp),%ebx
        movw %dx,(%ebx)
     end;
end;

procedure mouse_yrange (min,max:Longint);
begin
If Not Mouse Then Exit;

     asm
        movw $8,%ax
        movw 8(%ebp),%cx
        movw 12(%ebp),%dx
        pushl %ebp
        int   $0x33
        popl %ebp
     end;
end;

procedure mouse_xrange (min,max:Longint);
begin
If Not Mouse Then Exit;
     asm
        movw $7,%ax
        movw 8(%ebp),%cx
        movw 12(%ebp),%dx
        pushl %ebp
        int   $0x33
        popl %ebp
     end;
end;

Procedure Mouse_Cur(X,Y:Longint);
Begin
If Not Mouse Then Exit;
asm
movw $4,%ax
movw 8(%ebp),%cx
movw 12(%ebp),%dx
shlw $3,%cx
shlw $3,%dx
pushl %ebp
int  $0x33
popl %ebp
End;
End;

Procedure Mouse_Shape(BackColor,ForColor,Ascii:LongInt);
Begin
If Not Mouse Then Exit;
asm
movw $0,%bx
movw $0xa,%ax
{xorw %cx,%cx}
movw $0x00ff,%cx
movb 8(%ebp),%dh
shlb $4,%dh
addb 12(%ebp),%dh
{movb 16(%ebp),%dl}
xorb %dl,%dl
pushl %ebp
int  $0x33
popl %ebp
End;
End;

Procedure Mouse_Ascii(Ascii:LongInt);
Begin
If Not Mouse Then Exit;
asm
movw $0,%bx
movw $0xa,%ax
movw $0xff00,%cx
movb 8(%ebp),%dl
xorb %dh,%dh
pushl %ebp
int  $0x33
popl %ebp
End;
End;

Procedure Unseen_Mouse(x1,y1,x2,y2:Longint);
Begin
if Not Mouse Then Exit;
asm
movw $0x0010,%ax
movw 8(%ebp),%cx
movw 12(%ebp),%dx
movw 16(%ebp),%si
movw 20(%ebp),%di
pushl %ebp

int     $0x33
popl %ebp
end;
End;

Procedure Micky(Horizontal ,Vertical:Longint);
  Begin
    If Not Mouse Then Exit;
    asm
    movw $0x0f,%ax
    movw 8(%ebp),%cx
    movw 12(%ebp),%dx
    pushl %ebp
    int     $0x33
    popl %ebp
    end;
  End;

Function IsRPres:Boolean;
Var
W:Longint;
Begin
if Not Mouse Then Exit;
IsRPres:=False;
asm
movw $3,%ax
pushl %ebp
int  $0x33
popl %ebp
movw %bx,-4(%ebp)
end;
if (W and $02)=$02 Then IsRPres:=True;
end;

Function IsLPres:Boolean;
Var
W:Longint;
Begin
if Not Mouse Then Exit;
IsLPres:=False;
asm
movw $3,%ax
pushl %ebp
int   $0x33
popl %ebp
movw %bx,-4(%ebp)
end;
if (W and $01)=$01 Then IsLPres:=True;
end;

Procedure MWindow(x1,y1,x2,y2:Longint);
Begin
if Not Mouse Then Exit;
mouse_xrange(x1,x2);
mouse_yrange(y1,y2);
End;

Begin
Check_Mouse;
End.